perm filename SMALLX[NEW,LCS] blob sn#148547 filedate 1975-03-06 generic text, type T, neo UTF8
21600		SUBROUTINE UNPACK(M,N,I)
21700		COMMON/LL/L
21800	C  L IS FOR VIS. OR INVIS. LINES.
21900		N=I
22000		L=2
22100		M=N/100000000
22200		IF(M.EQ.0)GO TO 2
22300		L=3
22400		N=N-100000000*M
22500	2	M=N/10000
22600		N=MOD(N,10000)
22700		IF(M.GT.1000)M=1000-M
22800		IF(N.GT.1000)N=1000-N
22900		END
23000	
23100		FUNCTION ROFF(R)
23200		S=.5
23300		IF(R)S=-S
23400		ROFF=R+S
23500		RETURN
23600		END
23700	
23800	
23900	C**************  NOIR, RJBX, CENTX ***************
24000		SUBROUTINE NOIR(RMINI)
24100	C  BLACKS IN NOTES
24200	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
24300		COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
24400		EQUIVALENCE (PRE,IRN(1))
24500		DATA BL/7.5/,BH/6.7/
24600	C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
24700		IPOS=ROFF(RJQ(1)*DIS)
24800	CC	IF(RMINI.LT..9)IPOS=IPOS+1
24900		JPOS=ROFF(CENTR*RHT)
25000		IF(-RMINI.EQ.PRE)GO TO 10
25100		PRE=-RMINI
25200	CC	D=.25*RMINI
25250		D=.25
25300		B=BH*RMINI*RHT
25400		E=RMINI*DIS
25500		A=BL*E
25600		IC=A
25700		A=A*A
26200		E=-B/4.
26300		K=B
26400		B=B*B
26500	C  USES EQUATION FOR ELLIPSE
26600		N=1
26700		NX=2
26800	6	DO 1 J=-K,K
26900		Y=J*J
27000		X=SQRT(A-(A*Y)/B)
27100		L=E-X
27200		M=X+E
27300	C  THE TWO SIDES OF THE LINE
27400		IF(N)CALL EXCH(L,M)
27500		IRN(NX)=L
27600		IRN(NX+1)=M
27700	C     C IS VERTICLE POS.
27800		NX=NX+2
27900		E=E+D
28000	C   E IS TO TILT IT.
28100	1	N=-N
28200	10	CALL PLOT(IPOS+3,JPOS,3)
28300		N=2
28400	C   1ST LOC. OF ARRAY HAS "PRE"
28500		L=IPOS+IC
28600		DO 11 M=-K,K
28700		J=M+JPOS
28800		CALL PLOT(L+IRN(N),J,2)
28900		CALL PLOT(L+IRN(N+1),J,2)
29000	11	N=N+2
29100		END
29200	
32200	CC	SUBROUTINE RJBX(R)
32300	CC     COMMON Q(4),R3,RJQ(39)/STF/RSTFAC(8),RSTJ2
32400	CC	R3=R3+R*RSTJ2
32500	CC	END
32600	
32700	CC	SUBROUTINE CENTX
32800	CC     COMMON A,B,CENTR,D,E,R4,R(38) /STF/RSTFAC(8),RSTJ2
32900	CC	1 /POSI/STFF(8),JJ2,POS
33000	CC	CENTR=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
33100	CC	END
33200	C******** THE ABOVE ARE NOW IN SMALL.FAI (3/75)
33210	
33300	C****** 7, STF, POS, HGT, NUM OF SHARPS OR FLATS(+ OR -), CLEF
33400	C		      (	CLEF = TREB,0  BASS,1  ALT,2  TEN,3 )
33500		SUBROUTINE KSIG
33600	C   FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
33700	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,S,Z/STF/RSTFAC(-3/4),RSTJ2
33800		EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
33850		1,(R6,RJQ(4))
33900	
34000		JA=9
34100	C  USES THIS KEY NUM IN NOTWRT
34200	C   COUNTER
34300		IZ=IABS(J5)
34400	C  NUMBER OF CALLS ON NOTWRT
34500	C  THE CLEF NUM.  IT GETS WIPED OUT IN NOTWRT.
34600		JW=1
34610		R6=0
34700		IF(J5.GT.0)JW=2
34800	C   THE CODE FOR FLAT OR SHARP
34900	5333	CLEF=-(J6+1)
35000	C CLEF #S ARE CHNGD TO -1,-2,-3,-4 (TREB.,BA.,ALT.,TEN.)
35100	C  CLEF NOW SET IN MAIN PROG.
35200	C  IF NO CLEF GIVEN, TREBLE IS USED.
35300		T=10.
35400		IF(CLEF.LT.-2.)T=11.
35500		S=CLEF+4.
35600		IF(CLEF.EQ.-4)S=-1.
35700		IF(J5.LT.0)GO TO 253
35800		W=-3.
35900		YY=4.
36000		Z=11.
36100	C  SHARPS
36200		GO TO 353
36300	253	W=3.
36400		YY=-4.
36500		Z=7.
36600	C  FLATS
36700	353	N=1
36750		Z=Z+R4
36800		RX=JQ(1)
36900		RA=0
37000	C   RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
37100		DO 553 KA=1,IZ
37200		J5=JW
37300		RJQ(1)=RX+RA
37400		RA=RA+13.*RSTJ2
37500	C  MOVES OVER FOR NEXT ACCI.
37600		RD=Z
37700		R4=Z
37800		IF(CLEF.NE.-1.)GO TO 7
37900		IF(R4.GT.12.)R4=R4-7.
38000		GO TO 9
38100	7	R4=R4-S
38200		IF(R4.GT.T)R4=R4-7.
38300	C  ABOVE ARRANGES VERT. POS OF ACCIS.
38400	9	J4=R4
38500	C  FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
38600		CALL CENTX
38700		CALL NOTWRT
38800		Z=RD+W
38900		IF(N)Z=RD+YY
39000	553	N=-N
39100		END